home *** CD-ROM | disk | FTP | other *** search
- /*
- C* -- Expression parsing routines.
-
- source: exp.c
- started: November 2, 1985
- version:
- February 17, 1987
- March 7, 1989
-
- PUBLIC DOMAIN SOFTWARE
-
- The CSTAR program was placed in the public domain on June 15, 1991,
- by its author and sole owner,
-
- Edward K. Ream
- 1617 Monroe Street
- Madison, WI 53711
- (608) 257-0802
-
- CSTAR may be used for any commercial or non-commercial purpose.
-
- See cstar.h or cstar.c for a DISCLAIMER OF WARRANTIES.
- */
- #include "cstar.h"
-
- /*
- CAUTION: about extending casts: see lint.doc. Extension is done first,
- then sign conversion. This is built into exp.c/pe_fold1(),
- g2.c/sop_cast(), and x2.c/x_cast(). Note also that pointer addition
- depends on x_cast, so that if x_cast() is made to extend in a
- different way, the dependent calls may have to be modified to keep
- pointer addition correct. Pointer addition calls for a result of
- x_cast() as int_type or long_type (i.e. signed), so this should not
- be a substantial problem unless unsigned-to-signed extending casts
- are altered, which would be a botch. (But committees do make botches.)
- Since pointer addition should never overflow, except possibly when
- the (folded) scaled offset is added to the pointer, it should be clear
- in all cases what needs to happen.
- */
-
- /*
- type is:
-
- ASSIGN_EXPR for expression having outer effect
- ANY_EXPR for nonnull expression
- CONST_EXPR for primitive or composite constant
- XARITH_EXPR for expression usable as boolean
- ARG_EXPR for expression usable as argument
-
- The pe_list1() and pe_expr1() routines call each other without resetting
- the token and node stacks. The externally visible versions do reset
- those stacks.
- */
-
-
- /*
- Externally visible routines:
- */
- struct node * pe_list (register int type);
- int pe_oversize (int mclass, long value);
- struct node * pe_expr (void);
- struct node * pe_expr1 (bool comma_ok);
- bool pe_check (struct node * p, int type);
- void pe_massage (register struct type_node *t1,
- register struct node *p2, int op);
- int pe_number (struct node * p);
- void pe_retype (int mclass, register struct node * p2,
- int op);
-
- /*
- Internal routines.
-
- */
- static int pe_can_reduce (register int opr1, register int opr2);
- static void pe_cl_check (int oldclass, int newclass,
- long value, int op);
- static struct node * pe_cprim (void);
- static void pe_init (void);
- static bool pe_islval (register struct node *p, int op);
- static struct node * pe_fold1 (register struct node * p);
- static struct node * pe_fold2 (register struct node * p);
- static struct node * pe_list1 (register int type);
- static struct node * pe_npop (void);
- static void pe_npush (register struct node * p);
- static struct type_node * pe_opop (void);
- static void pe_opush (struct type_node *tp);
- static int pe_prec (int op);
- static struct node * pe_prim (void);
- static void pe_reduce (int op, struct type_node *t);
- static unsigned long pe_sizeof (void);
- static int pe_sprim (struct node * p);
- static int pe_tcheck (void);
- static void pe_tpop (void);
- static void pe_tpush (int tok);
- static bool pe_type1 (register struct node * p);
- static bool pe_type2 (register struct node * p);
- static bool pe_type3 (register struct node * p);
- static bool pe_zcheck (struct node *p);
-
- /*
- NOTE: pe_cprim(), pe_prim() depend on the structure of the target machine to
- a limited extent. It appears that gen_pp may be too late to do
- some aspects of these setups.
- */
-
- /*
- Define data structures used only by this file.
- */
- #define MAX_STACK 2000
- static byte expr_stk [MAX_STACK];
-
- static byte * tok_ptr; /* Top of operator stack. */
- static struct node ** node_ptr; /* Top of expression stack. */
- static int free_count; /* Free elements in stacks. */
- static int tok_count; /* # of operators in stack. */
- static int node_count; /* # of expressions in stack. */
-
- /*
- Certain shared items
- */
- extern struct type_node *intrn_decl;
- extern struct type_node *intrn_ptr;
-
- /*
- ----- INTERNAL ROUTINES -----
- */
-
- /*
- Stack routines.
- */
- static void
- pe_tpush(int tok)
- {
- /* CAUTION: this is used rather arbitrarily, and should not
- interrogate t_type or any of the other t_ globals. */
-
- /* compare ascending and descending pointers */
- TRACEPB("pe_tpush", printf("(%d)\n", tok));
-
- if (tok_ptr + 4 > (void *) node_ptr) {
- fatal("expression too complex");
- }
- *( CAST(int *) tok_ptr ) = tok;
- tok_ptr += sizeof(tok);
- tok_count++;
-
- TICKX("pe_tpush");
- }
-
- /* check if there is token-stack, needed for ternary reduce */
- static int
- pe_tcheck(void)
- {
- TICK("pe_tcheck");
- return (tok_ptr >= &expr_stk[0] + sizeof(int));
- }
-
- #define look_tok() ( *( (CAST(int *) (void *) tok_ptr) - 1) )
- /* returns an int! */
-
- static void
- pe_tpop(void)
- {
- TICKB("pe_tpop");
-
- if (tok_ptr < &expr_stk[0] + sizeof(int)) {
- fatal("pe_tpop: can't be done");
- }
- tok_ptr -= sizeof(int);
- tok_count--;
-
- TICKX("pe_tpop");
- }
-
- /* operator subtype to stack */
- static void
- pe_opush(struct type_node *tp)
- {
- /* compare ascending and descending pointers */
- TRACEPB("pe_opush", printf("(%p)\n", tp));
-
- if (tok_ptr + 4 > (void *) node_ptr) {
- fatal("expression too complex");
- }
- *( CAST(void **) tok_ptr ) = tp;
- tok_ptr += sizeof(struct type_node *);
-
- TICKX("pe_opush");
- }
-
- static struct type_node *
- pe_opop(void)
- {
- register struct type_node * tp;
-
- TICKB("pe_opop");
-
- if (tok_ptr < &expr_stk[0] + sizeof(tp)) {
- fatal("pe_opop: can't be done");
- }
- tok_ptr -= sizeof(struct type_node *);
- tp = *(CAST (void **) tok_ptr);
-
- RETURN_PTR("pe_opop", tp);
- }
-
- static void
- pe_npush(register struct node * p)
- {
- TRACEPB("pe_npush", printf("(%p)\n", p));
-
- if (p == NULL) {
- t_error("pe_npush: internal: NULL node");
- }
- if (tok_ptr + 4 > (void *) node_ptr) {
- fatal("expression too complex");
- }
-
- *--node_ptr = p;
- node_count++;
-
- TICKX("pe_npush");
- }
-
- static struct node *
- pe_npop(void)
- {
- register struct node * p;
-
- TICKB("pe_npop");
-
- if (node_count <= 0) {
- fatal("pe_npop: internal: ran out of nodes");
- }
-
- p = *node_ptr++;
- node_count--;
-
- RETURN_PTR("pe_npop", p);
- }
-
- /*
- Return TRUE if a tree p could be an lvalue if the types are right
- Otherwise return FALSE and give the error.
- This allows pe_typex() to detect certain errors.
-
- Lvalue form has root as an identifier, U*, array, ., or ->
- */
- bool
- pe_islval(register struct node *p, int op)
- {
- TRACEPB("pe_islval", printf("(%p, %d)\n", p, op));
-
- switch (p -> n_type) {
- case ID_TOK:
- if (p -> n_cid == NULL) {
- RETURN_BOOL("pe_islval", FALSE); /* it's a constant */
- }
- RETURN_BOOL("pe_islval", TRUE);
-
- case USTAR_TOK:
- case DOT_TOK:
- case ARROW_TOK:
- case ARRAY_TOK:
- RETURN_BOOL("pe_islval", TRUE);
-
- case CAST_TOK:
- if (pe_islval(p -> n_arg1, p -> n_arg1 -> n_type)) {
- RETURN_BOOL("pe_islval", TRUE);
- }
- /* FALLTHROUGH */
-
- default:
- t_2error("operand not assignable: ", ps_tok(op));
- }
- RETURN_BOOL("pe_islval", FALSE);
- }
-
- /*
- Return TRUE if we can reduce opr1 when opr2 follows.
-
- Return TRUE if opr1 has higher precedence than opr2.
- Else if opr1 and opr2 have the same precedence,
- return TRUE if they associate left to right.
-
- This code reflects the table on page 49 of K & R, except that
- LPAREN_TOK has the LOWEST precedence and associates R to L.
- */
- static int
- pe_can_reduce(register int opr1, register int opr2)
- {
- register int prec1, prec2;
-
- TRACEPB("pe_can_reduce", printf("(%d, %d)\n", opr1, opr2));
-
- if (opr1 == LPAREN_TOK) {
- /* Force the pushing of opr2. */
- RETURN_INT("pe_can_reduce", FALSE);
- }
-
- prec1 = pe_prec(opr1);
- prec2 = pe_prec(opr2);
-
- if (prec1 > prec2) {
- RETURN_INT("pe_can_reduce", TRUE);
- }
- else if (prec1 < prec2) {
- RETURN_INT("pe_can_reduce", FALSE);
- }
-
- /* prec1 == 3 is the ternary */
- else if (prec1 == 14 || prec1 == 3 || prec1 == 2) {
- /* Associate right to left. */
- RETURN_INT("pe_can_reduce", FALSE);
- }
- else {
- /* Associate left to right. */
- RETURN_INT("pe_can_reduce", TRUE);
- }
- }
-
- /*
- Return the precedence of an operator.
- Parentheses are handled separately.
-
- This code reflects the table on page 49 of K & R.
-
- If an operator can be both unary and binary, the default
- form (not known yet whether unary or binary) must be the
- binary form. Consider a + b &
- */
- static int
- pe_prec(int op)
- {
- TRACEP("pe_prec", printf("(%s)\n", ps_tok(op)));
-
- switch (op) {
- case LBRACK_TOK:
- case LPAREN_TOK:
- case ARROW_TOK:
- case DOT_TOK: return 15;
-
- case NOT_TOK: case TILDE_TOK:
- case INC_TOK: case DEC_TOK:
- case PRE_INC_TOK: case PRE_DEC_TOK:
- case POST_INC_TOK: case POST_DEC_TOK:
- case UMINUS_TOK:
- case USTAR_TOK: case UAND_TOK:
- case K_SIZEOF:
- case CAST_TOK:
- return 14;
-
- case STAR_TOK:
- case DIV_TOK:
- case MOD_TOK: return 13;
-
- case PLUS_TOK:
- case MINUS_TOK: return 12;
-
- case LSHIFT_TOK:
- case RSHIFT_TOK: return 11;
-
- case LT_TOK:
- case LE_TOK:
- case GT_TOK:
- case GE_TOK: return 10;
-
- case EQUAL_TOK:
- case NE_TOK: return 9;
-
- case AND_TOK: return 8;
- case XOR_TOK: return 7;
- case OR_TOK: return 6;
-
- case LAND_TOK: return 5;
- case LOR_TOK: return 4;
-
- case QUESTION_TOK:
- case COLON_TOK:
- return 3;
-
- case ASSN_TOK: case AND_ASSN_TOK:
- case DIV_ASSN_TOK: case LSHIFT_ASSN_TOK:
- case MINUS_ASSN_TOK: case MOD_ASSN_TOK:
- case OR_ASSN_TOK: case PLUS_ASSN_TOK:
- case RSHIFT_ASSN_TOK: case STAR_ASSN_TOK:
- case XOR_ASSN_TOK:
- return 2;
- case COMMA_TOK:
- return 1;
-
- default:
- printf("pe_prec: bad operator: %d, %s\n",op, ps_tok(op));
- fatal("pe_prec");
- }
- }
-
- /*
- Check an expression to see if it is of the indicated type.
- Call t_error() if it isn't.
- */
- bool
- pe_check(struct node * p, int type)
- {
- TRACEPB("pe_check", printf("(%p, %d)\n", p, type));
-
- if (p == NULL) {
- t_error("empty expression");
- RETURN_BOOL("pe_check", FALSE);
- }
-
- switch (type) {
- case ANY_EXPR:
- RETURN_BOOL("pe_check", TRUE);
-
- /* expression having an effect */
- /* WARNING: comma expressions */
- case ASSIGN_EXPR:
- switch(p -> n_type) {
- case PRE_INC_TOK: case PRE_DEC_TOK:
- case POST_INC_TOK: case POST_DEC_TOK:
- case ASSN_TOK: case AND_ASSN_TOK:
- case DIV_ASSN_TOK: case LSHIFT_ASSN_TOK:
- case MINUS_ASSN_TOK: case MOD_ASSN_TOK:
- case OR_ASSN_TOK: case PLUS_ASSN_TOK:
- case RSHIFT_ASSN_TOK: case STAR_ASSN_TOK:
- case XOR_ASSN_TOK:
- RETURN_BOOL("pe_check", TRUE);
-
- default:
- TRACE("pe_check", printf("p -> n_type = %d\n", p -> n_type));
- if (p -> n_cltype &&
- p->n_cltype -> t_typtok == VOID_TYPE) {
- }
- else {
- if (p -> n_type == CALL_TOK) {
- t_help("unused function-return value");
- }
- else {
- t_warning("unused value at outer level");
- }
- }
- }
- RETURN_BOOL("pe_check", FALSE);
-
- case CONST_EXPR:
- switch(p -> n_type) {
- case INT_TOK:
- case STRING_TOK:
- t_error("internal: pe_check: unprocessed const_tok");
- RETURN_BOOL("pe_check", FALSE);
- case ID_TOK:
- if (pe_number(p)) {
- RETURN_BOOL("pe_check", TRUE);
- }
- else {
- RETURN_BOOL("pe_check", FALSE);
- }
- default:
- t_error("non-constant constant expression");
- RETURN_BOOL("pe_check", FALSE);
- }
- case XARITH_EXPR:
- if (p -> n_cltype) switch (p -> n_cltype -> t_typtok) {
- case INT_TYPE:
- case POINTER_TYPE:
- RETURN_BOOL("pe_check", TRUE);
- case ARRAY_TYPE:
- t_warning("array name is apt to be always true");
- RETURN_BOOL("pe_check", TRUE);
- case VOID_TYPE:
- t_error("boolean expression is of void type");
- break;
- default:
- t_error("boolean expression has no arithmetic value");
- }
- else {
- t_error("internal: untyped boolean expression");
- }
- RETURN_BOOL("pe_check", FALSE);
-
- case ARG_EXPR:
- if (p -> n_cltype) switch (p -> n_cltype -> t_typtok) {
- case INT_TYPE:
- case POINTER_TYPE:
- case ARRAY_TYPE:
- RETURN_BOOL("pe_check", TRUE);
- case STRUCT_TYPE:
- case UNION_TYPE:
- t_error("argument is a structure");
- break;
- case VOID_TYPE:
- t_error("argument is of void type");
- break;
- default:
- t_error("argument has no arithmetic value");
- }
- else {
- t_error("internal: untyped boolean expression");
- }
- RETURN_BOOL("pe_check", FALSE);
-
- default:
- TRACEP("pe_check", printf("bad type: %d\n", type));
- fatal("internal: pe_check: called with bad type");
- RETURN_BOOL("pe_check", FALSE);
- }
- }
-
- /*
- Parse a comma list of expressions.
- THIS MUST NOT BE CALLED INSIDE AN EXPRESSION!!!!!!
- That is, called directly or indirectly by pe_expr()
- pe_list INITIALIZES expr. use ALIST1 instead.
- */
- struct node *
- pe_list(int type)
- {
- TRACEPB("pe_list", printf("(%d)\n", type));
-
- pe_init();
- RETURN_PTR("pe_list", pe_list1(type));
- }
-
- /*
- parse the comma list; make a cons_node only if there are two
- or more arguments
- */
- static struct node *
- pe_list1(register int type)
- {
- register struct node * p;
- register struct node * q;
- struct node * head, *prev;
-
- TRACEPB("pe_list1", printf("(%d)\n", type));
-
- head = NULL;
- prev = NULL;
- for (;;) {
- p = pe_expr1(FALSE);
- if (p == NULL) {
- break;
- }
- (void) pe_check(p, type);
- if (head == NULL) {
- /* No cons node needed yet. */
- head = p;
- }
- else {
- q = new_pnode(sizeof(struct cons_node));
- q -> n_type = SEPARATOR_TOK;
-
- if (prev == NULL) {
- /* Initial cons node. No unlinking to do. */
- q -> n_car = head;
- q -> n_next = p;
- head = q;
- prev = q;
- }
- else {
- /* Change the list structure. */
- q -> n_car = prev -> n_next;
- q -> n_next = p;
- prev -> n_next = q;
- prev = q;
- }
- }
-
- /* Continue as long as comma is seen. */
- if (t_type != COMMA_TOK) {
- break;
- }
- get_token();
- }
- RETURN_PTR("pe_list1", head);
- }
-
- /*
- Parse an arbitrary C expression, commas allowed if comma is TRUE
-
- The code below uses an operator precedence algorithm which
- uses an operator stack and a node stack, both housed in expr_stk[].
- Several auxiliary routines handle these stacks:
- pe_tpush(), pe_tpop(), pe_npush() and pe_npop();
- */
- static void
- pe_init(void)
- {
- byte * cp;
-
- TICK("pe_init");
-
- /* Initialize the stacks. */
- free_count = MAX_STACK-8;
- tok_count = 0;
- node_count = 0;
- tok_ptr = &expr_stk[0];
- cp = (void *) &expr_stk[0];
- cp += (MAX_STACK-4);
- node_ptr = /* (void *) */ CAST(struct node **) cp;
- return;
- }
-
- struct node *
- pe_expr(void)
- {
- TICKB("pe_expr");
-
- pe_init();
- RETURN_PTR("pe_expr", pe_expr1(TRUE));
- }
-
- /* pe_expr1 is visible for use by dcl.c in parsing array subscripts in casts */
- struct node *
- pe_expr1(bool comma_ok)
- {
- /* these items are for save-and-restore */
- byte * tok_psave;
- struct node ** node_psave;
- int free_csave;
- int tok_csave;
- int node_csave;
-
- register struct node * p;
- register struct node * p2;
- register int op;
- register struct type_node *t;
- register int ternary;
- register int g_f;
-
- /* save the stacks */
-
- TRACEPB("pe_expr1", printf("(comma ok: %d)\n", comma_ok));
-
- tok_psave = tok_ptr;
- node_psave = node_ptr;
- free_csave = free_count;
- tok_csave = tok_count;
- node_csave = node_count;
-
- ternary = 0;
-
- /*
- Handle null expressions cleanly.
- */
- switch(t_type) {
- case COMMA_TOK:
- if (comma_ok) {
- break;
- }
- /* FALLTHROUGH */
-
- case SEMICOLON_TOK:
- case RPAREN_TOK:
- RETURN_PTR("pe_expr1", NULL);
- }
-
- /*
- State S1: Start of expression
-
- handle unary ops or '('
- push them on the stack for evaluation later.
- */
- s1:
- TRACEP("pe_expr1", printf("state s1, t_type %d, line %d\n",
- t_type, t_line));
-
- /* The sizeof operator is handled by pe_prim(). */
- /* t_type is as currently provided via get_token */
-
- switch (t_type) {
-
- case TILDE_TOK:
- case NOT_TOK: break;
-
- case INC_TOK: t_type = PRE_INC_TOK; break;
- case DEC_TOK: t_type = PRE_DEC_TOK; break;
- case AND_TOK: t_type = UAND_TOK; break;
- case STAR_TOK: t_type = USTAR_TOK; break;
- case PLUS_TOK: t_type = UPLUS_TOK; break;
-
- case LPAREN_TOK:
- /* Possible cast, look ahead */
- TRACEP("pe_expr1", printf("s1: check for cast\n"));
- get_token();
- t = pd_cast();
- if (t != NULL) {
- pe_opush(t);
- pe_tpush(CAST_TOK);
- need(RPAREN_TOK);
- }
- else {
- TRACEP("pe_expr1", printf("s1: not a cast\n"));
- pe_tpush(LPAREN_TOK);
- comma_ok++;
- TRACEP("pe_expr1", printf("comma_ok++, comma_ok == %d\n", comma_ok));
- }
- goto s1;
-
- case MINUS_TOK:
- t_type = UMINUS_TOK;
- TRACEP("pe_expr1", printf("s1: unary minus special handling\n"));
- get_token();
- /* look ahead at the next token */
- switch (t_type) {
- case CHAR_TOK:
- case INT_TOK:
- case LONG_TOK:
- /*
- tamper with t_value and go to state s2
- with the negative t_value in place. this
- saves parsing one useless unary -, which is
- OK, but what is important is that it
- allows pe_cprim to see the negative constant,
- which is probably what the programmer also
- sees, and raise warnings, e.g. about an
- apparent integer that's actually long.
- */
- t_value = -t_value;
- goto s2;
- default:
- /* set things as though lookahead had never happened */
- pe_tpush(UMINUS_TOK);
- goto s1;
- }
- default:
- goto s2;
- }
-
- TRACEP("pe_expr1", printf("s1: fall-through\n"));
- pe_tpush(t_type);
- get_token();
- goto s1;
-
- /*
- State S2:
- We expect and must have a primitive (i.e., an identifier or constant)
- at this point.
-
- Push it onto the node stack.
- */
- s2:
- TRACEP("pe_expr1", printf("state s2\n"));
- p = pe_prim();
- TRACEP("pe_expr1", printf("state s2: prim returns node type %d\n",
- p -> n_type));
- /*
- WARNING: we have to keep the books balanced or else an
- expression will be totally botched by too many pulls
- on pe_npop, given that an incomplete expression is
- present in an argument parsed underneath by pe_list()
- */
- if (p == NULL) {
- p = new_pnode(sizeof(struct loc_node));
- p -> n_cltype = new_tnode();
- p -> n_type = ID_TOK;
- }
- pe_npush(p);
-
-
- /*
- State S3: After an identifier
-
- Take care of the post-operator, if any.
- */
- s3:
- TRACEP("pe_expr1", printf("state s3\n"));
-
- switch (t_type) {
- case INC_TOK:
- t_type = POST_INC_TOK;
- g_f = 1;
- break;
- case DEC_TOK:
- t_type = POST_DEC_TOK;
- g_f = 1;
- break;
-
- case POST_DEC_TOK:
- case POST_INC_TOK:
- break;
-
- case LPAREN_TOK:
- case LBRACK_TOK:
- g_f = 0;
- break;
-
- default:
- goto s4;
- }
-
- TRACEP("pe_expr1", printf("s3: reducing post %s\n", ps_tok(t_type)));
-
- if (tok_count > tok_csave && pe_can_reduce(op = look_tok(), t_type)) {
- /* reduce what is already on the stack */
- pe_tpop();
- if (op == CAST_TOK) {
- t = pe_opop();
- }
- else {
- t = NULL;
- }
- pe_reduce(op, t);
- }
- else {
- pe_reduce(t_type, NULL);
- if (g_f) {
- get_token();
- }
- }
- goto s3;
- /*
- State S4:
- End of expression, or continuation via binary operator,
- or balanced right parenthesis.
-
- If it is not a continuation,
- the whole op stack gets used up, at which point it exits.
-
- If it is a continuation, the op stack gets popped only until
- t_type has a higher precedence than the operator on top.
-
- The operator has already been obtained via get_token().
- */
- s4:
- TRACEP("pe_expr1", printf("state s4\n"));
-
- if (tok_count <= tok_csave) {
-
- TRACEP("pe_expr1", printf("stack empty. t_type=%d\n",t_type));
-
- switch(t_type) {
- case RBRACK_TOK:
- case RPAREN_TOK:
- case SEMICOLON_TOK:
- goto s5;
-
- case COMMA_TOK:
- if (!comma_ok) {
- goto s5;
- }
- pe_tpush(t_type);
- get_token();
- goto s1;
-
- case COLON_TOK:
- /* this colon always ends an expression, since there is
- no operator stack, and so no ? on the stack */
- TRACEP("pe_expr1", printf("terminal :\n"));
- goto s5;
-
- case QUESTION_TOK:
- /* question marks are counted in case excess :
- is found while something is on stack */
- TRACEP("pe_expr1", printf("ternary++\n"));
- ternary++;
- pe_tpush(t_type);
- get_token();
- goto s1;
-
- case LONG_TOK:
- case INT_TOK:
- case STRING_TOK:
- t_error("extra constant ignored");
- get_token();
- goto s4;
-
- case ID_TOK:
- t_2error("extra identifier ignored: ", t_symbol);
- get_token();
- goto s4;
- }
-
- if (is_binop(t_type)) {
- /* Valid operator. Push it and enter S1. */
- pe_tpush(t_type);
- get_token();
- goto s1;
- }
- else if (is_unop(t_type)) {
- t_2error("extra unary operator ignored: ",
- ps_tok(t_type));
- get_token();
- goto s4;
- }
- else {
- if (t_type == X_TOK || t_type == Z_TOK) {
- t_2error("expression runs into reserved: ",
- t_symbol);
- }
- else if (ps_tok(t_type)) {
- t_2error("expression runs into: ",
- ps_tok(t_type));
- }
- else {
- t_error("runon expression");
- }
- goto s5;
- }
- }
-
- /*
- The operator stack is not empty.
- Compare the operator on the op stack with the current operator.
- The operator on the stack may be a cast operator
-
- Operators are popped here and in reduce()
- This is the later part of s4
- */
- op = look_tok();
-
- TRACEP("expr", printf("s4a: op = %d %s, ternary = %d\n",
- op, ps_tok(op), ternary));
-
- /* unknown or known reducible t_types get reduced */
- /* known and nonreducible t_types get pushed at pushit: */
- switch(t_type) {
- case RPAREN_TOK:
- if (op == LPAREN_TOK) {
- if (comma_ok > 0) {
- comma_ok--;
- }
- TRACEP("pe_expr1", printf("comma_ok--, comma_ok == %d\n", comma_ok));
- /* cancel LPAREN & enter after-prim state */
- pe_tpop();
- get_token();
- goto s3;
- }
- /* here RPAREN is a terminator and flushes the stack */
- break;
-
- case QUESTION_TOK:
- if (pe_can_reduce(op, t_type)) {
- break;
- /* go reduce stack and try again */
- }
- /* first of ternary pair */
- TRACEP("pe_expr1", printf("ternary++\n"));
- ternary++;
- goto pushit;
-
- case COLON_TOK:
- /* second of ternary pair */
- if (pe_can_reduce(op, t_type) || ternary == 0) {
- break;
- }
- ternary--;
- goto pushit;
-
- case COMMA_TOK:
- if (!comma_ok || pe_can_reduce(op, t_type)) {
- break;
- }
- goto pushit;
-
- default:
- if (!is_binop(t_type)) {
- TRACEP("pe_expr1",printf("not binop: %d\n", t_type));
- break;
- }
- if (pe_can_reduce(op, t_type)) {
- break;
- }
- /* FALLTHROUGH */
-
- pushit:
- pe_tpush(t_type);
- get_token();
- goto s1;
- }
-
- /* reduce the operator that's on the stack and try again */
- pe_tpop();
- if (op == CAST_TOK) {
- t = pe_opop();
- TRACEP("pe_expr1",printf("cast type %\n", t));
- }
- else if (op == LPAREN_TOK) {
- t_error("excess or misplaced ( in expression");
- goto s4;
- }
- else {
- t = NULL;
- }
- pe_reduce (op,t);
- goto s4;
-
- /*
- State S5: End of expression.
- */
- s5:
- TRACEP("pe_expr1", printf("s5: node_count = %d , %d (local)\n",
- node_count, node_count-node_csave));
-
- p = pe_npop(); /* the last one off the stack */
- TRACE("pe_expr1_list", pr_expr(p));
- TRACE("pe_expr1_list", printf("\n"));
-
- if (node_count != node_csave) {
- t_error("too many operands (node stack not empty on exit)");
- }
-
- tok_ptr = tok_psave;
- node_ptr = node_psave;
- free_count = free_csave;
- tok_count = tok_csave;
- node_count = node_csave;
-
- TRACE("pe_npush",
- printf("pe_expr1: node_ptr set to %p on exit\n", node_ptr));
- RETURN_PTR("pe_expr1", p);
- }
-
- /*
- Reduce unary, binary, or ternary operator (including '[')
- by popping operands off the node stack and repushing a result.
- */
- static void
- pe_reduce(int op, struct type_node *t)
- {
- register struct node * p, * q;
-
- TRACEPB("pe_reduce", printf("op=%d %s, t=%p\n",
- op, ps_tok(op), t));
-
- if (is_unop(op) || op == POST_INC_TOK || op == POST_DEC_TOK) {
- /* Create a new unary node. */
- p = new_pnode(sizeof(struct unop_node));
- p -> n_type = op;
- p -> n_arg1 = pe_npop();
- p -> n_cltype = t;
-
- /* Fold constant expressions. */
- TRACEP("pe_reduce", printf("new unary node %p\n", p));
- if ((q = pe_fold1(p)) == NULL) {
- (void) pe_type1(p);
- pe_npush(p);
- }
- else {
- pe_npush(q);
- }
- }
- else if (op == LBRACK_TOK) {
- get_token();
- q = new_pnode(sizeof(struct binop_node));
- q -> n_type = ARRAY_TOK;
- q -> n_arg2 = pe_expr1(TRUE);
- q -> n_arg1 = pe_npop(); /* array-id expression */
- if ((p = pe_fold2(q)) == NULL) {
- (void) pe_type2(q);
- p = q;
- }
- (void) needend(RBRACK_TOK);
- TRACEP("pe_reduce", printf("array, p = %p\n", p));
- pe_npush(p);
- }
- else if (op == LPAREN_TOK) {
- get_token();
- p = new_pnode(sizeof(struct call_node));
- p -> n_type = CALL_TOK;
- p -> n_arg2 = q = pe_list1(ARG_EXPR);
- if (q && q -> n_type != SEPARATOR_TOK) {
- call_1arg++;
- }
- p -> n_arg1 = pe_npop(); /* function-id expression */
- (void) pe_type2(p);
- (void) needend(RPAREN_TOK);
- TRACEP("pe_reduce", printf("function call, p = %p\n", p));
- pe_npush(p);
- }
- else if (is_binop(op)) {
- /* Create a binary node. */
- p = new_pnode(sizeof(struct binop_node));
- p -> n_type = op;
- TRACEP("pe_reduce",printf("new binary node %p\n", p));
-
- /* Reduce the operator on the top of the stack. */
- p -> n_arg2 = pe_npop();
- p -> n_arg1 = pe_npop();
- /* CAUTION: pe_fold2 can convert binary (-) to unary (-) */
- if ((q = pe_fold2(p)) == NULL) {
- (void) pe_type2(p);
- TRACEP("pe_type2",
- printf("%p->%p: ", p, p -> n_cltype);
- pr_type(p -> n_cltype); printf("\n"));
- pe_npush(p);
- }
- else {
- pe_npush(q);
- }
- }
- else if (op == COLON_TOK) {
- TRACEP("pe_reduce",printf("colon operator\n"));
- /* Create a ternary node, maybe */
- if (!pe_tcheck()) {
- t_error("unexpected \':\'");
- (void) pe_npop();
- }
- else if ( (op = look_tok()) == QUESTION_TOK) {
- pe_tpop();
- p = new_pnode(sizeof(struct ternop_node));
- p -> n_type = QUESTION_TOK;
-
- p -> n_arg3 = pe_npop();
- p -> n_arg2 = pe_npop();
- p -> n_arg1 = pe_npop();
- if (pe_type3(p)) {
- /* p = fold3(p) */
- }
- pe_npush(p);
- }
- else {
- /* just align the stack */
- (void) pe_npop();
- t_error("unexpected \':\'");
- }
- }
- else if (op == QUESTION_TOK) {
- TRACEP("pe_reduce",printf("bad ? operator\n"));
- /* just align the stack */
- (void) pe_npop();
- t_error("? without associated :");
- }
- else {
- /* a bad op should never be pushed in the first place! */
- printf("pe_reduce: bad operator %d\n", op);
- fatal("pe_reduce: bad operator");
- }
-
- TICKX("pe_reduce");
- }
-
- /*
- Check a PARSER operand to see if it is a constant of value zero
- and a scalar type
- */
- static bool
- pe_zcheck(struct node *p)
- {
- TRACEPB("pe_zcheck", printf("(%p)\n", p));
-
- if (p && p -> n_type == ID_TOK &&
- p -> n_cid == NULL && p -> n_const == 0L &&
- p -> n_reg1 == 0) {
- if (p -> n_cltype) {
- switch(p -> n_cltype -> t_typtok) {
- case INT_TYPE:
- case POINTER_TYPE:
- RETURN_BOOL("pe_zcheck", TRUE);
- }
- }
- }
- RETURN_BOOL("pe_zcheck", FALSE);
- }
-
- /*
- Set type involving a unary operator.
- A type always gets attached to p, and the routine returns
- FALSE if that type had to be made of whole cloth.
- (If it is desired to have the made-up type be VOID instead
- of INT, do it here, and don't change new_tnode!)
- */
- static bool
- pe_type1(register struct node * p)
- {
- register struct node *p1;
- register struct type_node *t, *t1;
- register int op;
-
- TRACEPB("pe_type1", printf("(%p)\n", p));
-
- p1 = p -> n_arg1;
- op = p -> n_type;
- if (p1 == NULL) {
- t_2error("pe_type1: internal: no arg of unary operator: ",
- ps_tok(op));
- if (p -> n_cltype == NULL) {
- p -> n_cltype = new_tnode();
- }
- RETURN_BOOL("pe_type1", FALSE);
- }
-
- TRACEP("pe_type1", printf("node %p, op %d: %s\n", p, op, ps_tok(op)));
-
- t1 = p1 -> n_cltype;
- if (t1 == NULL) {
- t_2error("pe_type1: internal: untyped arg of unary operator: ",
- ps_tok(op));
- TRACEP("pe_type1",
- printf("arg is:\n"); pr_expr(p1); printf("\n"));
-
- if (p -> n_cltype == NULL) {
- p -> n_cltype = new_tnode();
- }
- RETURN_BOOL("pe_type1", FALSE);
- }
- else if (op != CAST_TOK) {
- /* default setting */
- p -> n_cltype = t1;
- }
-
- switch (op) {
- case CAST_TOK:
- t = p -> n_cltype;
- /* t1 is the argument type */
- if (t -> t_typtok != VOID_TYPE) switch (t1 -> t_typtok) {
- case POINTER_TYPE:
- if (t -> t_tsize < t1 -> t_tsize) {
- t_warning("pointer cast to narrower type");
- }
- break;
-
- case STRUCT_TYPE:
- case ARRAY_TYPE:
- case UNION_TYPE:
- case FUNCTION_TYPE:
- t_warning("address-of required?");
- t_error("cast from an aggregate");
- break;
- }
- /* t is the cast type */
- switch (t -> t_typtok) {
- case INT_TYPE:
- if ((t -> t_mclass & UNSIGNED_MOD) &&
- t1 -> t_typtok == INT_TYPE &&
- !(t1 -> t_mclass & UNSIGNED_MOD) &&
- (t -> t_tsize > t1 -> t_tsize) ) {
- t_warning("ambiguous cast will extend then convert");
- }
- break;
-
- case POINTER_TYPE:
- switch (t1 -> t_typtok) {
- case POINTER_TYPE:
- case ARRAY_TYPE:
- switch(t -> t_link -> t_typtok) {
- case INT_TYPE:
- case POINTER_TYPE:
- switch(t1->t_link->t_typtok) {
- case INT_TYPE:
- case POINTER_TYPE:
- if(t1 -> t_link -> t_tsize !=
- t -> t_link -> t_tsize) {
- t_help("coerced pointer: beware of 68000 scalar alignment");
- }
- }
- }
- }
- if (t -> t_tsize != t1 -> t_tsize) {
- t_warning("type of mismatching width cast to pointer");
- }
- break;
-
- case STRUCT_TYPE:
- case UNION_TYPE:
- case FUNCTION_TYPE:
- t_error("cast into an aggregate");
- break;
- }
- break;
-
- case UMINUS_TOK:
- if (t1 -> t_typtok == INT_TYPE &&
- t1 -> t_mclass & UNSIGNED_MOD) {
- t_warning("negation of unsigned item");
- }
- /* FALLTHROUGH */
-
- case TILDE_TOK:
- case UPLUS_TOK:
- if (t1 -> t_typtok != INT_TYPE) {
- t_2error("arithmetic on non-integer: ",
- ps_tok(op));
- RETURN_BOOL("pe_type1", FALSE);
- }
- break;
-
- case UAND_TOK:
- (void) pe_islval(p1, UAND_TOK);
- t = new_tnode();
- t -> t_typtok = POINTER_TYPE;
- t -> t_tsize = POINTER_SIZE;
- t -> t_link = t1;
- p -> n_cltype = t;
- break;
-
- case NOT_TOK:
- p -> n_cltype = new_tnode();
- break;
-
- case PRE_INC_TOK:
- case PRE_DEC_TOK:
- case POST_INC_TOK:
- case POST_DEC_TOK:
- if (t1 -> t_typtok != INT_TYPE
- && t1 -> t_typtok != POINTER_TYPE) {
- t_2error("nonscalar operand: ", ps_tok(op));
- RETURN_BOOL("pe_type1", FALSE);
- }
- if (!pe_islval(p1, op)) {
- RETURN_BOOL("pe_type1", FALSE);
- }
- if (t1 -> t_typtok == POINTER_TYPE &&
- t1 -> t_link -> t_typtok == VOID_TYPE) {
- t_2error(ps_tok(op), " on pointer to void");
- }
- break;
-
- case USTAR_TOK:
- if (t1 -> t_typtok == POINTER_TYPE ||
- t1 -> t_typtok == ARRAY_TYPE) {
- t1 = t1 -> t_link;
- if (t1 == NULL) {
- t_error("internal: pointer to no-type");
- RETURN_BOOL("pe_type1", FALSE);
- }
- else {
- p -> n_cltype = t1;
- }
- }
- else {
- t_error("indirection on non-pointer");
- RETURN_BOOL("pe_type1", FALSE);
- }
- break;
-
- default:
- printf("unknown op %d\n", op);
- fatal("pe_type1: unknown unary op");
- }
- RETURN_BOOL("pe_type1", TRUE);
- }
-
- /*
- Set type of an expression involving a binary operator.
- A type always gets attached to p, and the routine returns
- FALSE if that type had to be made of whole cloth.
- (If it is desired to have the made-up type be VOID instead
- of INT, do it here, and don't change new_tnode!)
- */
- static bool
- pe_type2(register struct node * p)
- {
- register struct node *p1, *p2;
- register struct type_node *t, *t1, *t2;
- int op;
-
- TRACEPB("pe_type2", printf("(%p)\n", p));
-
- p1 = p -> n_arg1;
- p2 = p -> n_arg2;
-
- t1 = p1 -> n_cltype;
- t2 = p2 -> n_cltype;
-
- op = p -> n_type;
-
- if (t1 == NULL || (t2 == NULL && op != CALL_TOK)) {
- /* second arg of call is a list which presently has no type */
- t_2error("internal: untyped operand of: ", ps_tok(op));
- p -> n_cltype = new_tnode();
- RETURN_BOOL("pe_type2", FALSE);
- }
- p -> n_cltype = t1;
- /* this is the default return */
-
-
- /* handle the various ops */
- /* assignments continue on through for a post-check as well */
- switch (op) {
- case ASSN_TOK:
- switch(t1 -> t_typtok) {
- default:
- t_error("non-assignable lvalue type: =");
- RETURN_BOOL("pe_type2", FALSE);
- case INT_TYPE:
- case POINTER_TYPE:
- ;
- }
- if (!pd_taeq(t1, t2)) {
- if (t1 -> t_typtok == POINTER_TYPE) {
- if (pe_zcheck(p2)) {
- /* it's ok */
- }
- else if (t2 -> t_typtok == POINTER_TYPE ||
- t2 -> t_typtok == ARRAY_TYPE) {
- t_warning("pointers to different objects: =");
-
- TRACE("pe_type2", pr_type(t1);
- pr_type(t2));
- /* but proceed despite warning */
- }
- else {
- t_error("type mismatch: =");
- RETURN_BOOL("pe_type2", FALSE);
- }
- }
- else {
- if (t2 -> t_typtok == INT_TYPE &&
- m_size(t1 -> t_mclass) == m_size(t2 -> t_mclass)) {
- t_warning("type mismatch: =");
- }
- else {
- t_error("type mismatch: =");
- TRACEP("pe_type2",
- pr_type(t1);
- pr_type(t2);
- );
- RETURN_BOOL("pe_type2", FALSE);
- }
- }
- }
- /* fall out of switch to lvalue check */
- break;
-
- case PLUS_ASSN_TOK:
- case MINUS_ASSN_TOK:
- switch(t1 -> t_typtok) {
- case INT_TYPE:
- switch (t2 -> t_typtok) {
- case POINTER_TYPE:
- case ARRAY_TYPE:
- t_3serr(NULL, "integer ", ps_tok(op), " pointer");
- RETURN_BOOL("pe_type2", FALSE);
- default:
- t_2error("non-assignable type: ", ps_tok(op));
- RETURN_BOOL("pe_type2", FALSE);
- case INT_TYPE:
- if (!pd_teq(t1, t2)) {
- t_2error("type mismatch: ", ps_tok(op));
- RETURN_BOOL("pe_type2", FALSE);
- }
- break;
- }
- break;
-
- case POINTER_TYPE:
- if (t1 -> t_link -> t_typtok == VOID_TYPE) {
- t_2error(ps_tok(op), " into pointer to void");
- }
- switch (t2 -> t_typtok) {
- case POINTER_TYPE:
- case ARRAY_TYPE:
- t_3serr(NULL, "pointer ", ps_tok(op), " pointer");
- RETURN_BOOL("pe_type2", FALSE);
- default:
- t_2error("non-assignable type: ", ps_tok(op));
- RETURN_BOOL("pe_type2", FALSE);
- case INT_TYPE:
- break;
- }
- break;
-
- default:
- t_2error("non-assignable lvalue type: ", ps_tok(op));
- RETURN_BOOL("pe_type2", FALSE);
- }
- /* go do assignment check */
- break;
-
- case LSHIFT_ASSN_TOK:
- case RSHIFT_ASSN_TOK:
- if (t1 -> t_typtok != INT_TYPE || t2 -> t_typtok != INT_TYPE) {
- t_2error("non-numeric assignment: ", ps_tok(op));
- RETURN_BOOL("pe_type2", FALSE);
- }
- break;
-
- case AND_ASSN_TOK:
- case DIV_ASSN_TOK:
- case MOD_ASSN_TOK:
- case OR_ASSN_TOK:
- case STAR_ASSN_TOK:
- case XOR_ASSN_TOK:
- if (t1 -> t_typtok != INT_TYPE || t2 -> t_typtok != INT_TYPE) {
- t_2error("non-numeric assignment: ", ps_tok(op));
- RETURN_BOOL("pe_type2", FALSE);
- }
- else if (!pd_teq(t1, t2)) {
- t_2error("type mismatch: ", ps_tok(op));
- RETURN_BOOL("pe_type2", FALSE);
- }
- break; /* go do assignment check */
-
- /* 6 relational operators and two boolean operators. */
- case EQUAL_TOK:
- case NE_TOK:
- if (t1 -> t_typtok == INT_TYPE) {
- p -> n_cltype = new_tnode();
- if (pd_teq(t1, t2)) {
- RETURN_BOOL("pe_type2", TRUE);
- }
- if (t2 -> t_typtok == INT_TYPE &&
- m_size(t1 -> t_mclass) == m_size(t2 -> t_mclass)) {
- t_warning("type mismatch: =");
- RETURN_BOOL("pe_type2", TRUE);
- }
- else {
- t_2error("type mismatch: ", ps_tok(op));
- RETURN_BOOL("pe_type2", FALSE);
- }
- }
- /* FALLTHROUGH */
- case GE_TOK:
- case GT_TOK:
- case LE_TOK:
- case LT_TOK:
- p -> n_cltype = new_tnode();
- switch(t1 -> t_typtok) {
- case INT_TYPE:
- if (pd_teq(t1, t2)) {
- RETURN_BOOL("pe_type2", TRUE);
- }
- else {
- t_2error("type mismatch: ", ps_tok(op));
- RETURN_BOOL("pe_type2", FALSE);
- }
-
- case ARRAY_TYPE:
- case POINTER_TYPE:
- switch (t2 -> t_typtok) {
- case ARRAY_TYPE:
- case POINTER_TYPE:
- if (!pd_taeq(t1, t2)) {
- t_2warning("pointers to different objects: ", ps_tok(op));
- }
- RETURN_BOOL("pe_type2", TRUE);
-
- case INT_TYPE:
- t_2error("type mismatch: ", ps_tok(op));
- RETURN_BOOL("pe_type2", FALSE);
- }
- }
- t_2error("comparison with nonscalar: ", ps_tok(op));
- RETURN_BOOL("pe_type2", FALSE);
-
- case LAND_TOK:
- case LOR_TOK:
- p -> n_cltype = new_tnode();
- switch(t1 -> t_typtok) {
- case INT_TYPE:
- case POINTER_TYPE:
- case ARRAY_TYPE:
- switch(t2 -> t_typtok) {
- case INT_TYPE:
- case POINTER_TYPE:
- case ARRAY_TYPE:
- RETURN_BOOL("pe_type2", TRUE);
- }
- }
- t_2error("operand must be scalar: ", ps_tok(op));
- RETURN_BOOL("pe_type2", FALSE);
-
- case COMMA_TOK:
- p -> n_cltype = t2;
- mark_noneed(p1);
- RETURN_BOOL("pe_type2", TRUE);
-
- /* 2 addition operators. */
- case PLUS_TOK:
- switch(t1 -> t_typtok) {
- case INT_TYPE:
- switch(t2 -> t_typtok) {
- case INT_TYPE:
- if (!pd_teq(t1, t2)) {
- t_error("type mismatch: +");
- RETURN_BOOL("pe_type2", FALSE);
- }
- break;
-
- case POINTER_TYPE:
- if (t2 -> t_link -> t_typtok == VOID_TYPE) {
- t_error("addition to pointer to void");
- }
- case ARRAY_TYPE:
- p -> n_cltype = t2;
- break;
- default:
- t_error("integer + nonscalar");
- RETURN_BOOL("pe_type2", FALSE);
- }
- break;
-
- case POINTER_TYPE:
- if (t1 -> t_link -> t_typtok == VOID_TYPE) {
- t_error("addition to pointer to void");
- }
-
- case ARRAY_TYPE:
- switch (t2 -> t_typtok) {
- case INT_TYPE:
- break;
-
- case POINTER_TYPE:
- case ARRAY_TYPE:
- t_error("pointer + pointer");
- RETURN_BOOL("pe_type2", FALSE);
- default:
- t_error("pointer + non-scalar");
- RETURN_BOOL("pe_type2", FALSE);
- }
- break;
-
- default:
- t_error("non-scalar + something");
- RETURN_BOOL("pe_type2", FALSE);
- }
- RETURN_BOOL("pe_type2", TRUE);
-
- case MINUS_TOK:
- switch (t1 -> t_typtok) {
- case INT_TYPE:
- switch (t2 -> t_typtok) {
- case INT_TYPE:
- if (!pd_teq(t1, t2)) {
- t_error("type mismatch: -");
- RETURN_BOOL("pe_type2", FALSE);
- }
- break;
-
- case POINTER_TYPE:
- t_error("integer - pointer");
- RETURN_BOOL("pe_type2", FALSE);
-
- default:
- t_error("integer - nonscalar");
- RETURN_BOOL("pe_type2", FALSE);
- }
- break;
-
- case POINTER_TYPE:
- if (t1 -> t_link -> t_typtok == VOID_TYPE) {
- t_error("subtraction from pointer to void");
- }
-
- case ARRAY_TYPE:
- switch (t2 -> t_typtok) {
- case INT_TYPE:
- break;
-
- case POINTER_TYPE:
- case ARRAY_TYPE:
- /* pointer - pointer shall be long */
- /* cast it if you want it truncated !!! */
- p -> n_cltype = new_tnode();
- p -> n_cltype -> t_mclass |= LONG_MOD;
- break;
-
- default:
- t_error("pointer - non-scalar");
- RETURN_BOOL("pe_type2", FALSE);
- }
- break;
-
- default:
- t_error("non-scalar - something");
- RETURN_BOOL("pe_type2", FALSE);
- }
- RETURN_BOOL("pe_type2", TRUE);
-
- /* 8 miscellaneous arithmetic operators. */
- case AND_TOK:
- case OR_TOK:
- case XOR_TOK:
- case MOD_TOK:
- case STAR_TOK:
- case DIV_TOK:
- if (!pd_teq(t1, t2)) {
- t_2error("type mismatch: ", ps_tok(op));
- RETURN_BOOL("pe_type2", FALSE);
- }
- /* FALLTHROUGH */
-
- case LSHIFT_TOK:
- case RSHIFT_TOK:
- if (t1 -> t_typtok != INT_TYPE || t2 -> t_typtok != INT_TYPE) {
- t_2error("non-numeric operand: ", ps_tok(op));
- RETURN_BOOL("pe_type2", FALSE);
- }
- RETURN_BOOL("pe_type2", TRUE);
-
- case CALL_TOK:
- /* walk down function-returning link to get result type */
- if (t1 -> t_typtok != FUNCTION_TYPE) {
- t_error("function identifier isn't");
- RETURN_BOOL("pe_type2", FALSE);
- }
- t = t1 -> t_link;
- goto exit_check;
-
- case ARRAY_TOK:
- /* walk down the array-of link to get result type */
- if (t1 -> t_typtok != POINTER_TYPE
- && t1 -> t_typtok != ARRAY_TYPE) {
- t_error("subscript applied to non-array");
- RETURN_BOOL("pe_type2", FALSE);
- }
- if (t2 -> t_typtok != INT_TYPE) {
- t_error("array subscript not int");
- }
- t = t1 -> t_link;
- goto exit_check;
-
- case DOT_TOK:
- if (t1 -> t_typtok == STRUCT_TYPE) {
- if (t2 -> t_typtok != SELEMENT_TYPE) {
- t_error("struct . non-structelement");
- RETURN_BOOL("pe_type2", FALSE);
- }
- }
- else if (t1 -> t_typtok == UNION_TYPE) {
- if (t2 -> t_typtok != UELEMENT_TYPE) {
- t_error("union . non-unionelement");
- RETURN_BOOL("pe_type2", FALSE);
- }
- }
- else {
- t_error("non-struct/union . something");
- RETURN_BOOL("pe_type2", FALSE);
- }
- t = t2 -> t_link;
- goto exit_check;
-
- case ARROW_TOK:
- if (t1 -> t_typtok == ARRAY_TYPE) {
- t_help("array -> something is bad form");
- }
- else if (t1 -> t_typtok != POINTER_TYPE) {
- t_error("non-pointer -> something");
- RETURN_BOOL("pe_type2", FALSE);
- }
- t = t1 -> t_link;
- if (t == NULL) {
- t_error("internal: pointer to undefined");
- RETURN_BOOL("pe_type2", FALSE);
- }
- else if (t -> t_typtok == STRUCT_TYPE) {
- if (t2 -> t_typtok != SELEMENT_TYPE) {
- t_error("struct -> non-structelement");
- RETURN_BOOL("pe_type2", FALSE);
- }
- }
- else if (t1 -> t_typtok == UNION_TYPE) {
- if (t2 -> t_typtok != UELEMENT_TYPE) {
- t_error("union -> non-unionelement");
- RETURN_BOOL("pe_type2", FALSE);
-
- }
- }
- else {
- t_warning("pointer on -> is not struct/union pointer");
- }
- t = t2 -> t_link;
-
- exit_check:
- if (t) {
- p -> n_cltype = t;
- }
- else {
- t_2error("internal: linked-NULL-type of operand of: ",
- ps_tok(op));
- RETURN_BOOL("pe_type2", FALSE);
- }
- RETURN_BOOL("pe_type2", TRUE);
-
- default:
- printf("unknown op %d\n", op);
- fatal("pe_type2: unknown binop");
- }
- /* assignments fall out of the switch! */
-
- /* check assignments */
- if (!pe_islval(p1, op)) {
- RETURN_BOOL("pe_type2", TRUE);
- }
- else if (t1 -> t_mclass & CONST_MOD) {
- t_2error(ps_tok(op), " into lvalue of const type");
- RETURN_BOOL("pe_type2", FALSE); /* ekr */
- }
- else if (t1 -> t_typtok == POINTER_TYPE &&
- t2 -> t_typtok == POINTER_TYPE &&
- t1 -> t_link -> t_mclass & CONST_MOD &&
- !(t2 -> t_link -> t_mclass & CONST_MOD)) {
- t_2warning(ps_tok(op),
- " of pointer to non-const into pointer to const");
- RETURN_BOOL("pe_type2", FALSE); /* ekr */
- }
-
- TICKX("pe_type2");
- }
-
- /*
- Set type of an expression involving a ternary operator.
- A type always gets attached to p, and the routine returns
- FALSE if that type had to be made of whole cloth.
- (If it is desired to have the made-up type be VOID instead
- of INT, do it here, and don't change new_tnode!)
- */
- static bool
- pe_type3(register struct node * p)
- {
- register struct node *p1, *p2, *p3;
- register struct type_node *t1, *t2, *t3;
-
- TRACEPB("pe_type3", printf("(%p)\n", p));
-
- p1 = p -> n_arg1;
- p2 = p -> n_arg2;
- p3 = p -> n_arg3;
-
- t1 = p1 -> n_cltype;
- t2 = p2 -> n_cltype;
- t3 = p3 -> n_cltype;
-
- p -> n_cltype = t2;
-
- if (p1 == NULL || p3 == NULL) {
- RETURN_BOOL("pe_type3", FALSE);
- }
-
- if (p -> n_type == QUESTION_TOK) {
- if (!pd_t1eq(t2, t3)) {
- if (t2 -> t_typtok == POINTER_TYPE &&
- t3 -> t_typtok == POINTER_TYPE) {
- t_warning("?: selects pointers to different types");
- t_help("result of ?: is pointer to void");
- t2 = new_tnode();
- t2 -> t_typtok = VOID_TYPE;
- t2 -> t_tsize = 0;
- t3 = new_tnode();
- t3 -> t_typtok = POINTER_TYPE;
- t3 -> t_tsize = POINTER_SIZE;
- t3 -> t_link = t2;
- p -> n_cltype = t3;
- }
- else {
- t_error("?: selects items of different types");
- }
- RETURN_BOOL("pe_type3", FALSE); /* disallow reduce */
- }
- if (t1) {
- switch(t1 -> t_typtok) {
- default:
- t_error("switch in ?: is of unusable type");
- RETURN_BOOL("pe_type3", FALSE);
- case INT_TYPE:
- case POINTER_TYPE:
- ;
- }
- }
- else {
- t_error("internal: untyped switch in ?:");
- }
- }
- else {
- printf("unknown op %d\n", p -> n_type);
- fatal("pe_type3: unknown ternary op");
- }
- RETURN_BOOL("pe_type3", TRUE);
- }
-
- /*
- Fold expressions involving a unary operator.
- */
- static struct node *
- pe_fold1(register struct node * p)
- {
- register struct node *p1;
- register struct type_node *t, *t1;
- register long value, val1;
- register int op;
-
- TICK("pe_fold1");
-
- p1 = p -> n_arg1;
- if ((op = p -> n_type) == CAST_TOK) {
- if (!pe_sprim(p1) ||
- (t = p -> n_cltype) == NULL ||
- (t1 = p1 -> n_cltype) == NULL) {
- return NULL;
- }
- /* do according to cast type itself */
- switch (t -> t_typtok) {
- case INT_TYPE:
- switch (t1 -> t_typtok) {
- case POINTER_TYPE:
- case ARRAY_TYPE:
- t1 -> t_typtok = INT_TYPE;
- t1 -> t_mclass = UNSIGNED_MOD & LONG_MOD;
- t1 -> t_tdim = 0;
- t1 -> t_tsize = 4;
-
- /* FALL_THROUGH */
- case INT_TYPE:
- pe_retype(t -> t_mclass, p1, op);
- break;
-
- default:
- t_error("cast on nonscalar constant: shouldn't happen");
- }
- break;
-
- case POINTER_TYPE:
- case ARRAY_TYPE:
- /* constant pointer is manifest; no warning */
- p1 -> n_cltype = t;
- break;
-
- default:
- t_error("cast into non-scalar");
- }
- t1 -> t_mclass |= CONST_MOD;
- return p1;
- }
- else {
- if (!pe_number(p1)) {
- return NULL;
- }
- switch(op) {
- case NOT_TOK:
- p1 -> n_const = (long) !p1 -> n_const;
- p1 -> n_cltype -> t_mclass &= ~ARITH_MODS;
- return p1;
-
- case UMINUS_TOK:
- if (p1 -> n_cltype -> t_mclass & UNSIGNED_MOD) {
- t_warning("negation of unsigned constant; result unsigned");
- }
- p1 -> n_const = - p1 -> n_const;
- /* FALLTHROUGH */
-
- case UPLUS_TOK:
- return p1;
-
- case TILDE_TOK:
- p1 -> n_const = ~p1 -> n_const;
- return p1;
- }
- }
- return NULL;
- }
-
- /*
- Fold an expression involving a binary operator.
- Only arithmetic and relational operators may be folded.
- The problem of assignment into a constant is handled by pe_type2().
- */
- static struct node *
- pe_fold2(register struct node * p)
- {
- union {
- long sval;
- unsigned long uval;
- } value, val1, val2;
- register int op, m1, m2;
- register struct node *p1, *p2;
- struct type_node *t1, *t2;
-
- TICK("pe_fold2");
-
- /* WARNING: it also might attempt to fold the subtraction
- of two addresses */
-
- TRACEP("pe_fold2", printf("op=%d, %s\n",
- p -> n_type, ps_tok(p -> n_type)));
-
- op = p -> n_type;
- p1 = p -> n_arg1;
- p2 = p -> n_arg2;
-
- t1 = p1 -> n_cltype;
- t2 = p2 -> n_cltype;
-
- if (t1 == NULL || t2 == NULL) {
- fatal("pe_fold2: untyped operand");
- }
- if (op == PLUS_TOK) {
- if (pe_number(p1)) {
- /*
- NOTE: for the following multiplication, it
- is unnecessary to distinguish between signed
- and unsigned operands, since they all lead to
- the same bit-pattern, which is added in the
- same way to the pointer. That is, all effects
- of operand signs lie outside the low 32 bits
- and are therefore never extant. See note on
- signed vs unsigned multiplication.
- */
- if (t2 -> t_typtok != INT_TYPE && pe_sprim(p2)) {
- TRACEP("pe_fold2", printf("fold pointer\n"));
- p2 -> n_const +=
- p1->n_const * (long) t2 -> t_link -> t_tsize;
- return p2;
- }
- }
- else if (pe_number(p2)) {
- if (t1 -> t_typtok != INT_TYPE && pe_sprim(p1)) {
- TRACEP("pe_fold2", printf("fold pointer\n"));
- p1 -> n_const +=
- p2->n_const * (long) t1 -> t_link -> t_tsize;
- return p1;
- }
- }
- }
-
- /* massage constant types and short out certain constants */
- if (!pe_number(p1)) {
- if (pe_number(p2)) {
- switch(op) {
- case PLUS_TOK:
- case PLUS_ASSN_TOK:
- case MINUS_TOK:
- case MINUS_ASSN_TOK:
- if (p2 -> n_const == 0) {
- return p1;
- }
- break;
- case STAR_TOK:
- case STAR_ASSN_TOK:
- case DIV_TOK:
- case DIV_ASSN_TOK:
- if (p2 -> n_const == 1) {
- return p1;
- }
- break;
- case MOD_TOK:
- if (p2 -> n_const == 1) {
- p2 -> n_const = 0;
- return p2;
- }
- break;
- case LSHIFT_TOK:
- case LSHIFT_ASSN_TOK:
- case RSHIFT_TOK:
- case RSHIFT_ASSN_TOK:
- if (p2 -> n_const == 0) {
- return p1;
- }
- break;
- }
- pe_massage(t1, p2, op);
- }
- return NULL;
- }
- else if (!pe_number(p2)) {
- switch(op) {
- case PLUS_TOK:
- if (p1 -> n_const == 0) {
- return p2;
- }
- break;
- case MINUS_TOK:
- /* CAUTION: assumption about unop_node and binop_node
- similarity */
- if (p1 -> n_const == 0) {
- p -> n_type = UMINUS_TOK;
- p -> n_arg1 = p2;
- (void) pe_type1(p);
- return p;
- }
- break;
- case STAR_TOK:
- if (p1 -> n_const == 1) {
- return p2;
- }
- break;
- case LSHIFT_TOK:
- case RSHIFT_TOK:
- if (p1 -> n_const == 0) {
- return p1;
- }
- break;
- }
- if (!is_assnop(op)) {
- pe_massage(t2, p1, op);
- }
- return NULL;
- }
-
- TRACEP("pe_fold2", printf("folding two constants\n"));
- if (op == COMMA_TOK) {
- t_warning("constant , constant");
- return NULL;
- }
- /*
- when folding two constants, use the K&R rules.
- we choose to do this with constants because of a
- variety of practical problems that arise otherwise
-
- note that using a constant expression as a function
- argument is a very dangerous business, expecially if
- macros are involved, and it may be well to cast such
- things explicitly; such casts raise warnings in C-Star
- if the cast type is too narrow to hold the object
- */
- if ((m1 = t1 -> t_mclass) != (m2 = t2 -> t_mclass)) {
- if (m1 & LONG_MOD && !(m2 & LONG_MOD)) {
- pe_retype(m1 | (m2 & UNSIGNED_MOD), p2, op);
- m2 = t2 -> t_mclass;
- }
- else if (m2 & LONG_MOD && !(m1 & LONG_MOD)) {
- pe_retype(m2 | (m1 & UNSIGNED_MOD), p1, op);
- m1 = t1 -> t_mclass;
- }
- else if (m2 & CHAR_MOD && !(m1 & CHAR_MOD)) {
- pe_retype(m1 | (m2 & UNSIGNED_MOD), p2, op);
- m2 = t2 -> t_mclass;
- }
- else if (m1 & CHAR_MOD && !(m2 & CHAR_MOD)) {
- pe_retype(m2 | (m1 & UNSIGNED_MOD), p1, op);
- m1 = t1 -> t_mclass;
- }
- /* now they are both the same length */
- if (m1 & UNSIGNED_MOD && !(m2 & UNSIGNED_MOD)) {
- pe_retype(m1, p2, op);
- m2 = m1;
- }
- else if (m2 & UNSIGNED_MOD && !(m1 & UNSIGNED_MOD)) {
- pe_retype(m2, p1, op);
- m1 = m2;
- }
- }
- /* now they are standardly signed versus unsigned */
-
-
-
- val1.sval = p1 -> n_const;
- val2.sval = p2 -> n_const;
-
- if (m1 & UNSIGNED_MOD) {
- switch (op) {
- case GE_TOK: value.sval = (long)(val1.uval >= val2.uval); break;
- case GT_TOK: value.sval = (long)(val1.uval > val2.uval); break;
- case LE_TOK: value.sval = (long)(val1.uval <= val2.uval); break;
- case LT_TOK: value.sval = (long)(val1.uval < val2.uval); break;
-
- case STAR_TOK: value.uval = val1.uval * val2.uval; break;
- case DIV_TOK: if (val2.uval == 0) {
- value.uval = 0;
- t_error("division by zero: /");
- }
- else {
- value.uval = val1.uval / val2.uval;
- }
- break;
-
- case MOD_TOK: if (val2.uval == 0) {
- t_error("division by zero: %");
- value.uval = 0;
- }
- else {
- value.uval = val1.uval % val2.uval;
- }
- break;
- default:
- goto sign_ed;
- } /* end switch */
- goto around;
- } /* end if clause */
- sign_ed:
- switch (op) {
- /* 6 relational operators. */
- case GE_TOK: value.sval = (long)(val1.sval >= val2.sval); break;
- case GT_TOK: value.sval = (long)(val1.sval > val2.sval); break;
- case LE_TOK: value.sval = (long)(val1.sval <= val2.sval); break;
- case LT_TOK: value.sval = (long)(val1.sval < val2.sval); break;
- case EQUAL_TOK: value.sval = (long)(val1.sval == val2.sval); break;
- case NE_TOK: value.sval = (long)(val1.sval != val2.sval); break;
-
- /* 10 arithmetic operators. */
- case LSHIFT_TOK: value.sval = val1.sval << val2.sval; break;
- case RSHIFT_TOK: value.sval = val1.sval >> val2.sval; break;
- case AND_TOK: value.sval = val1.sval & val2.sval; break;
- case OR_TOK: value.sval = val1.sval | val2.sval; break;
- case XOR_TOK: value.sval = val1.sval ^ val2.sval; break;
- case PLUS_TOK: value.sval = val1.sval + val2.sval; break;
- case MINUS_TOK: value.sval = val1.sval - val2.sval; break;
-
- case STAR_TOK: value.sval = val1.sval * val2.sval; break;
- case DIV_TOK: if (val2.sval == 0) {
- value.sval = 0;
- t_error("division by zero: /");
- }
- else {
- value.sval = val1.sval / val2.sval;
- }
- break;
-
- case MOD_TOK: if (val2.sval == 0) {
- t_error("division by zero: %");
- value.sval = 0;
- }
- else {
- value.sval = val1.sval % val2.sval;
- }
- break;
- default:
- return NULL;
- }
- around:
-
- /* Return pointer to updated constant node. */
- p1 -> n_const = value.sval;
-
- /* Fiddle with the result width */
- switch (op) {
- case GE_TOK:
- case GT_TOK:
- case LE_TOK:
- case LT_TOK:
- case EQUAL_TOK:
- case NE_TOK:
- t1 -> t_mclass &= ~ARITH_MODS;
- break;
-
- case AND_TOK:
- case OR_TOK:
- case XOR_TOK:
- case PLUS_TOK:
- case MINUS_TOK:
- case STAR_TOK:
- case DIV_TOK:
- case MOD_TOK:
- if (pe_oversize(m1, value.sval)) {
- if (m1 & CHAR_MOD) {
- m1 &= ~SIZE_MODS;
- t1 -> t_tsize = INT_SIZE;
- t_2warning("constant result is int: ",
- ps_tok(p -> n_type));
- }
- else {
- m1 &= ~SIZE_MODS;
- m1 |= LONG_MOD;
- t1 -> t_tsize = LONG_SIZE;
- t_2warning("constant result is long: ",
- ps_tok(p -> n_type));
- }
- }
- t1 -> t_mclass = m1;
- break;
- }
- return p1;
- }
-
- /*
- t1 is a type and p2 is a manifest constant.
- attach t1 to p2 in certain cases.
- */
- void
- pe_massage(register struct type_node *t1, register struct node *p2, int op)
- {
- TRACEPB("pe_massage", printf("(%p, %p, %d)\n", t1, p2, op));
- TRACE("pe_massage",
- pr_type(t1);
- printf("<< %s >>\n",
- ps_tok(op));
- pr_type(p2 -> n_cltype);
- printf("\n"));
-
- switch(t1 -> t_typtok) {
- case POINTER_TYPE:
-
- TRACEP("pe_massage", printf("pointer <> %ld\n",
- p2 -> n_const));
- switch(op) {
- case ASSN_TOK:
- case EQUAL_TOK:
- case NE_TOK:
- /* in the case of constant zero, force a match */
- if (p2 -> n_const == 0) {
- TRACEP("pe_massage", printf(" substitute\n"));
- p2 -> n_cltype = t1;
- }
- }
- break;
-
- case INT_TYPE:
- switch(op) {
- /*
- shift-operators have no length constraints
- and so they need not be massaged
- */
- case GE_TOK:
- case GT_TOK:
- case LE_TOK:
- case LT_TOK:
- case EQUAL_TOK:
- case NE_TOK:
-
- case ASSN_TOK:
- case PLUS_ASSN_TOK:
- case MINUS_ASSN_TOK:
- case AND_ASSN_TOK:
- case OR_ASSN_TOK:
- case XOR_ASSN_TOK:
- case STAR_ASSN_TOK:
- case DIV_ASSN_TOK:
- case MOD_ASSN_TOK:
-
- case AND_TOK:
- case OR_TOK:
- case XOR_TOK:
- case PLUS_TOK:
- case MINUS_TOK:
-
- case STAR_TOK:
- case DIV_TOK:
- case MOD_TOK:
- pe_retype(t1 -> t_mclass, p2, op);
- break;
- }
- break;
- }
-
- TICKX("pe_massage");
- }
-
- /*
- copy int mclass into int type of CONSTANT p2.
- do not do this to declared items; their typenodes are NOT unique
- raise various warnings.
- */
- void
- pe_retype(int mclass, register struct node *p2, int op)
- {
- register struct type_node *t2;
-
- TRACEPB("pe_retype", printf("(%d, %p, %d)\n", mclass, p2, op));
- TRACEP("pe_retype",
- printf("across %s\n", ps_tok(op));
- if(ps_tok(op) == NULL) {
- printf("op=%d\n", op);
- });
-
- t2 = p2 -> n_cltype;
- pe_cl_check(t2 -> t_mclass, mclass, p2 -> n_const, op);
- t2 -> t_mclass &= ~ARITH_MODS;
- t2 -> t_mclass |= mclass & ARITH_MODS;
- t2 -> t_tsize = m_size(mclass);
-
- TICKX("pe_retype");
- }
-
- /*
- generate warnings pursuant to copying or changing a constant from one
- mclass into another
- */
- static void
- pe_cl_check(int oldclass, int newclass, long value, int op)
- {
- register int o;
-
- TRACEPB("pe_cl_check", printf("(%d, %d, %ld, %d)\n", oldclass, newclass, value, op));
-
- if ( (newclass & UNSIGNED_MOD) &&
- !(oldclass & UNSIGNED_MOD) && value < 0) {
- t_2warning("negative constant converted to unsigned: ", ps_tok(op));
- }
- if (o = pe_oversize(newclass, value)) {
- if (o == 1) {
- if ( (newclass & CHAR_MOD) && (oldclass & CHAR_MOD) ) {
- }
- else {
- t_2warning("positive constant becomes negative: ", ps_tok(op));
- }
- }
- else {
- t_2error("oversize constant: ", ps_tok(op));
- }
- }
-
- TICKX("pe_cl_check");
- }
-
- /*
- Return nonzero if an integer constant doesn't fit its mclass
- */
- int
- pe_oversize(int mclass, long value)
- {
- register long m;
-
- TRACEPB("pe_oversize", printf("(%d, %ld)\n", mclass, value));
-
- m = 0xFFFF0000L;
- if (mclass & LONG_MOD) {
- m = 0;
- }
- else if (mclass & CHAR_MOD) {
- m = 0xFFFFFF00L;
- }
- if ((value & m) != 0 && (~value & m) != 0 ) {
- /* constant won't fit, period */
- RETURN_INT("pe_oversize", 2);
- }
- if (!(mclass & UNSIGNED_MOD)) {
- /* RIGHT shift with negative-sign insertion */
- m >>= 1;
- m |= 0x80000000L;
- if ((value & m) != 0 && (~value & m) != 0 ) {
- /* unsigned overflows to negative */
- RETURN_INT("pe_oversize", 1);
- }
- }
- RETURN_INT("pe_oversize", 0);
- }
-
- /*
- Return the size of a manifest numeric constant; or else 0 if
- it's not.
- */
- int
- pe_number(struct node * p)
- {
- register struct type_node * t;
-
- TRACEPB("pe_number", printf("(%p)\n", p));
-
- if (p == NULL || p -> n_type != ID_TOK) {
- RETURN_INT("pe_number", 0);
- }
- if (p -> n_mode || p -> n_cid || p -> n_reg1) {
- RETURN_INT("pe_number", 0);
- }
- if (t = p -> n_cltype) {
- if (t -> t_typtok == INT_TYPE) {
- RETURN_INT("pe_number", (int) t -> t_tsize);
- }
- }
- RETURN_INT("pe_number", 0);
- }
-
- /*
- Return the size of a manifest numeric constant; or else 0 if
- it's not.
- */
- static int
- pe_sprim(struct node * p)
- {
- register struct type_node * t;
-
- TRACEPB("pe_sprim", printf("(%p)\n", p));
-
- if (p == NULL || p -> n_type != ID_TOK) {
- RETURN_INT("pe_sprim", 0);
- }
- if (p -> n_mode || p -> n_cid || p -> n_reg1) {
- RETURN_INT("pe_sprim", 0);
- }
- if (t = p -> n_cltype) {
- switch(t -> t_typtok) {
- case INT_TYPE:
- case POINTER_TYPE:
- case ARRAY_TYPE:
- RETURN_INT("pe_sprim", (int) t -> t_tsize);
- }
- }
- RETURN_INT("pe_sprim", 0);
- }
-
- /*
- Parse a (syntactical) primitive and return a pointer.
-
- Return a pointer to a suitable node.
-
- Items treated as primitives are:
- identifier
- constant (including sizeof)
- Dn, An
- */
- static struct node *
- pe_prim(void)
- {
- register struct node *p;
- register struct st_node *id;
- register struct type_node *t, *t1;
-
- TRACEPB("pe_prim", printf("called on t_type %d\n",t_type));
-
- switch (t_type) {
-
- case INT_TOK:
- case LONG_TOK:
- case CHAR_TOK:
- case K_SIZEOF:
- case STRING_TOK:
- p = pe_cprim();
- break;
-
- case CC_TOK:
- case ID_TOK:
-
- TRACEP("pe_prim", printf("id, subtype %d\n", t_subtype));
-
- p = new_pnode(sizeof(struct loc_node));
- p -> n_reg1 = real_reg(t_subtype);
- id = ast_lookup(t_symbol);
- if (id == NULL) {
- t = new_tnode();
- id = rst_enter(t_symbol, t, NULL_CLASS);
- get_token();
- if (t_type == LPAREN_TOK && t_subtype == 0) {
- /* assume it's a function name */
- /* implicit declaration */
- t1 = new_tnode();
- t1 -> t_typtok = FUNCTION_TYPE;
- t1 -> t_tsize = 0;
- t1 -> t_link = t;
- id -> st_type = t1;
- id -> st_sclass = CODE_CLASS;
- }
- else if (t_subtype == 0) {
- t_2error("undefined variable: ", id -> st_name);
- }
- else {
- t_2error("undefined register: ", id -> st_name);
- }
- }
- else {
- get_token();
- }
- p -> n_cltype = id -> st_type;
- if (p -> n_reg1 == 0) {
- p -> n_cid = id; /* points to symbol table entry */
- }
- break;
-
- default:
- need(NULL_TOK);
- p = NULL;
- }
- RETURN_PTR("pe_prim", p);
- }
-
- /*
- Parse a primitive constant.
- This must EITHER
- return something
- OR
- flag t_error
- */
- static struct node *
- pe_cprim(void)
- {
- register struct node * p;
- register struct type_node *t, *t1;
- register struct st_node *id;
- register unsigned long len;
-
- TICKB("pe_cprim");
-
- t = new_tnode();
- t -> t_mclass |= CONST_MOD;
-
- p = new_pnode(sizeof(struct loc_node));
- p -> n_type = ID_TOK;
- p -> n_cltype = t;
-
- TRACE("pe_cprim", printf("loc_node = %p\n", p));
-
- switch(t_type) {
- case INT_TOK:
- TRACEP("pe_cprim",
- printf("short integer %ld 0x%lx\n",
- t_value, t_value));
-
- p -> n_const = t_value;
- if (p -> n_const > INT_MAX || p -> n_const < - INT_MAX - 1) {
- /*
- this warning is especially important in function
- calls if ints don't default to long size,
- which they don't unless some changes are made
- */
- t_help("constant taken as long");
- t -> t_mclass |= LONG_MOD;
- t -> t_tsize = LONG_SIZE;
- }
- get_token();
- break;
-
- case LONG_TOK:
- TRACEP("pe_cprim",
- printf("long integer %ld 0x%lx\n",
- t_value, t_value));
-
- p -> n_const = t_value;
- t -> t_mclass |= LONG_MOD;
- t -> t_tsize = LONG_SIZE;
- get_token();
- break;
-
- case CHAR_TOK:
- TRACEP("pe_cprim",
- printf("char (byte) %ld 0x%lx\n",
- t_value, t_value));
-
- p -> n_const = t_value;
- t -> t_typtok = INT_TYPE;
- t -> t_mclass |= (CHAR_MOD | UNSIGNED_MOD);
- t -> t_tsize = 1;
- get_token();
- break;
-
- case K_SIZEOF:
- p -> n_const = (long) pe_sizeof();
- if (p -> n_const > INT_MAX) {
- t_help("result of sizeof is long");
- t -> t_mclass |= LONG_MOD;
- t -> t_tsize = LONG_SIZE;
- }
- break;
-
- case STRING_TOK:
- /*
- NOTE: ANSI says such a string shouldn't be
- CONST. We may need to provide such
- an option eventually.
- */
- t -> t_typtok = INT_TYPE;
- t -> t_mclass |= CHAR_MOD | CONST_MOD;
- t -> t_tsize = 1;
-
- t1 = new_tnode();
- t1 -> t_typtok = ARRAY_TYPE;
-
- t1 -> t_link = t;
- t1 -> t_mclass |= CONST_MOD;
-
- p -> n_cltype = t1;
-
- /*
- now make up an internal label. treat the string
- as a static global in order to get the aliasing right
- */
- p -> n_cid = id = rst_enter(str_name(), t1, STATICG_CLASS);
- id -> st_alias = id -> st_name;
-
- id -> st_iniz = new_iblock(1L);
- len = (unsigned long) str_val(t_symbol);
- id -> st_iniz -> idim = t1 -> t_tdim = t1 -> t_tsize = len;
- id -> st_iniz -> idata[0] . ipt =
- chr_salloc(t_symbol, (int) len);
- id -> st_iniz -> itype = ISTRA_DEC;
-
- t = new_tnode();
- t -> t_typtok = DELEMENT_TYPE;
- t -> t_parent = p -> n_cid;
- t -> t_tsize = t1 -> t_tsize;
- t -> t_link = t1;
-
- if (intrn_decl) {
- intrn_ptr -> t_list = t;
- }
- else {
- intrn_decl = t;
- }
- intrn_ptr = t;
-
- get_token();
- break;
-
- default:
- t_2error("internal: pe_cprim: called with bad type at: ",
- t_symbol);
- }
- RETURN_PTR("pe_cprim", p);
- }
-
- /*
- Return the RESULT of a sizeof expression; a number, not a node.
- */
- static unsigned long
- pe_sizeof(void)
- {
- register struct node * p;
- register struct type_node *t;
- register unsigned long size;
-
- TICKB("pe_sizeof");
-
- get_token(); /* eat the K_SIZEOF */
- need(LPAREN_TOK);
- if ((t = pd_cast()) != NULL) {
- size = t -> t_tsize;
- if (size == 0) {
- t_error("sizeof returns zero");
- }
- }
- else {
- p = pe_expr1(TRUE);
- if (p == NULL) {
- t_error("sizeof has no argument");
- size = 0;
- }
- else if ( (t = p -> n_cltype) == NULL) {
- printf("pe_sizeof: internal: no type");
- size = 0;
- }
- else {
- size = t -> t_tsize;
- if (size == 0) {
- t_error("sizeof returns zero");
- }
- }
- }
- need(RPAREN_TOK);
- RETURN_ULONG("pe_sizeof", size);
- }
-